#!/usr/bin/perl -w
# Run a command on individual machines, or on whole classes of machines
# vim:tw=100 sw=2 expandtab ft=perl

use strict;
use Net::HTTP;
use Carp;
use Sys::Hostname;
use Data::Dumper;
use IO::File;
use IO::Select;
use Digest::MD5 qw( md5_hex );
use Getopt::Long;
use POSIX qw( setsid );
use File::Temp qw/ tempfile tempdir /;

use vars qw( $rollout_url $verbosity $safe_mode @skip_steps @force_dangerous
             %networks @only_steps );
$rollout_url = "http://rollout.domain";
$verbosity = 1;
$safe_mode = 0;
my $hostname = hostname;

# Global variables
$hostname =~ s/\..*//;
my(@all_steps, @steps, %steps_code, $current_step);
use vars qw( %m );
my $log = "";

sub l(@) {
  my($text, $indent) = @_;
  return unless $verbosity;
  $indent = 2 unless defined $indent;
  print " "x$indent;
  print "$text\n";
  $log .= "$text\n";
  return 0;
}

sub w(@) {
  my($text, $indent) = @_;
  $indent = 2 unless defined $indent;
  print " "x$indent;
  print "WARNING: $text\n";
  $log .= "WARNING: $text\n";
  return 0;
}

sub fatal(@) {
  print "------ FATAL ERROR ------\n";
  print "$_\n" foreach (@_);
  print "Current Step: $current_step\n" if $current_step;
  exit 1 if $current_step;
}

sub d($) { return v(Dumper(@_)) }
sub v(@) { return l(@_) if $verbosity > 1 }

sub http_file($) {
  my($file) = @_;

  my $url = $file =~ /^http:\/\// ? $file : "$rollout_url/$file";

  my($host, $port, $path) = $url =~ /^(?:http:\/\/)?([^\/:]+)(?::(\d+))?(\/?.*)/;

  my $s = Net::HTTP->new(Host => $host, PeerPort => $port || 80) || fatal $@;

  $s->write_request(GET => $path, 'User-Agent' => "Rollout/1.0");
  my($code, $mess, %h) = $s->read_response_headers;

  if ($code != 200) {
    w "GET $url returned $code";
    return undef;
  }

  my $res;
  while (1) {
    my $buf;
    my $n = $s->read_entity_body($buf, 1024);
    fatal "Read failed: $!" unless defined $n;
    last unless $n;
    $res .= $buf;
  }

  return $res;
}

sub http_index($) {
  my($base) = @_;

  $base .= "/" unless $base =~ /\/$/;

  my $html = http_file($base);
  return () unless $html;

  my @files;
  while ($html =~ /^<img src="[^"]+" alt="[^"]+"> <a href="([^"]+)">.+?<\/a> /mg) {
    push @files, $1 if $1;
  }
  return @files;
}

sub i_isa {
  my($class, $m) = @_;

  $m ||= $hostname;
  return 0 unless $m{$m} && $m{$m}->{ISA};
  return $m{$m}->{ISA}{$class} if $m{$m}->{ISA}{$class};

  foreach (keys %{$m{$m}->{ISA}}) {
    my $ret = i_isa($class, $_);
    return $ret if $ret;
  }
  return 0;
}

sub i_isa_fetchall {
  my($class, $m) = @_;

  $m ||= $hostname;

  my @list;
  return () unless $m{$m};

  push @list, $m{$m}->{$class} if $m{$m}->{$class};

  foreach (keys %{$m{$m}->{ISA} || {}}) {
    push @list, i_isa_fetchall($class, $_);
  }

  return ($m eq $hostname)
    ? wantarray ? @list : \@list
     : @list;
}

sub i_isa_classes {
  my($class) = @_;

  $class ||= $hostname;

  my %list;
  return () unless $m{$class};

  foreach (keys %{$m{$class}->{ISA} || {}}) {
    if ($m{$class}) {
      $list{$_} = 1 foreach i_isa_classes($_);
    }
    $list{$_} = 1;
  }

  return keys %list;
}

my $machines_data = http_file "rollout.cfg";
die "Can't retrieve rollout configuration rollout.cfg: $@" unless $machines_data;

eval $machines_data;
die "Can't parse rollout configuration rollout.cfg: $@" unless keys %m;

my @fragments = http_index "fragments";
foreach (sort @fragments) {
  my $_class = $_;
  my $text = http_file "fragments/$_";
  eval $text if $text;
  fatal "Config fragment \"$_\" failed: $@" if $@;
}

v "Evaluated Rollout config: ". scalar(grep /^[a-z]/, keys %m). " devices, ".
  scalar(grep /^[A-Z]/, keys %m). " classes";

die "You must specify a host or class" unless @ARGV;

if ($ARGV[0] =~ /^-?-?[h\?](?:elp)?$/) {
  my %classes;
  print "Available Classes:\n";
  foreach my $m (keys %m) {
    next if $m =~ /^[A-Z]/ || $m{$m}->{skip};
    $classes{$_}++ foreach (i_isa_classes($m));
  }
  print map { sprintf("  %-30s %3d devices\n", $_, $classes{$_}) } sort keys %classes;
  exit;
}

my $class = shift @ARGV;
die "You must specify a command" unless @ARGV;

my %machines;
foreach my $m (keys %m) {
  next if $m{$m}->{skip};
  $machines{$m}++ if $class eq 'all' && $m =~ /^[a-z]/;
  if ($m eq $class || i_isa($class, $m)) {
    $machines{$m}++ unless $m =~ /^[A-Z]/;
  }
}

my($columns, $rows);
eval {
  require Term::Size;
  import Term::Size;
  ($columns, $rows) = Term::Size::chars(*STDOUT{IO});
};
$columns ||= 80;

foreach my $hostname (sort keys %machines) {
  my $x = $columns - length($hostname) - 5;
  print(("-" x $x). "[ $hostname ]-\n");
  system("ssh", "-x", "-a", $hostname, @ARGV);
  print "\n";
}

